home *** CD-ROM | disk | FTP | other *** search
/ Aminet 21 / Aminet 21 (1997)(GTI - Schatztruhe)[!][Oct 1997].iso / Aminet / gfx / show / gs503_data.lha / Ghostscript / data / gs_lev2.ps < prev    next >
Text File  |  1997-08-14  |  15KB  |  460 lines

  1. %    Copyright (C) 1990, 1996, 1997 Aladdin Enterprises.  All rights reserved.
  2. % This file is part of Aladdin Ghostscript.
  3. % Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author
  4. % or distributor accepts any responsibility for the consequences of using it,
  5. % or for whether it serves any particular purpose or works at all, unless he
  6. % or she says so in writing.  Refer to the Aladdin Ghostscript Free Public
  7. % License (the "License") for full details.
  8. % Every copy of Aladdin Ghostscript must include a copy of the License,
  9. % normally in a plain ASCII text file named PUBLIC.  The License grants you
  10. % the right to copy, modify and redistribute Aladdin Ghostscript, but only
  11. % under certain conditions described in the License.  Among other things, the
  12. % License requires that the copyright notice and this notice be preserved on
  13. % all copies.
  14.  
  15. % Initialization file for Level 2 functions.
  16. % When this is run, systemdict is still writable,
  17. % but (almost) everything defined here goes into level2dict.
  18.  
  19. level2dict begin
  20.  
  21. % ------ System and user parameters ------ %
  22.  
  23. % User parameters are managed entirely in C code.
  24. /currentuserparams {        % - currentuserparams <dict>
  25.   mark .currentuserparams .dicttomark
  26.  } odef
  27. systemdict begin
  28. /getuserparam {            % <name> getuserparam <value>
  29.   .getuserparam
  30. } odef
  31. end
  32.  
  33. % Some system parameters are managed entirely at the PostScript level.
  34. % We take care of that here.
  35. systemdict begin
  36. currentdict /systemparams known not {
  37.   /systemparams 10 dict readonly def
  38. } if
  39. /getsystemparam {        % <name> getsystemparam <value>
  40.   //systemparams 1 index .knownget { exch pop } { .getsystemparam } ifelse
  41. } odef
  42. end
  43. /currentsystemparams {        % - currentsystemparams <dict>
  44.   mark .currentsystemparams //systemparams { } forall .dicttomark
  45. } odef
  46. /.setsystemparams /setsystemparams load def
  47. /setsystemparams {        % <dict> setsystemparams -
  48.     % Check that we will be able to set the PostScript-level
  49.     % system parameters.
  50.    dup
  51.     { //systemparams 3 -1 roll .knownget
  52.        { type 1 index type ne
  53.       { pop /setsystemparams load /typecheck signalerror }
  54.      if
  55.      dup type /stringtype eq
  56.       { dup dup gcheck exch rcheck or not
  57.          { /setsystemparams load /invalidaccess signalerror }
  58.         if
  59.       }
  60.      if pop
  61.        }
  62.        { pop
  63.        }
  64.       ifelse
  65.     }
  66.    forall
  67.     % Set the C-level system params.  If this succeeds, we know that
  68.     % the password check succeeded.
  69.    dup .setsystemparams
  70.     % Now set the PostScript-level params.  We must copy local strings
  71.     % into global VM.
  72.    dup
  73.     { //systemparams 2 index known
  74.        {        % Stack: key newvalue
  75.      dup gcheck not
  76.       {        % The only composite objects that can have passed
  77.             % the type check are strings.
  78.         .currentglobal true .setglobal
  79.         1 index length string exch .setglobal
  80.         copy readonly
  81.       }
  82.      if //systemparams 3 1 roll .forceput
  83.        }
  84.        { pop pop
  85.        }
  86.       ifelse
  87.     }
  88.    forall pop
  89. } odef
  90.  
  91. % ------ Miscellaneous ------ %
  92.  
  93. (<<) cvn            % - << -mark-
  94.   /mark load def
  95. (>>) cvn            % -mark- <key1> <value1> ... >> <dict>
  96.   /.dicttomark load def
  97. /languagelevel 2 def
  98. % When running in Level 2 mode, this interpreter is supposed to be
  99. % compatible with PostScript version 2010 (I think).
  100. /version (2010) def
  101.  
  102. % If binary tokens are supported by this interpreter,
  103. % set an appropriate default binary object format.
  104. /setobjectformat where
  105.  { pop
  106.    /RealFormat getsystemparam (IEEE) eq { 1 } { 3 } ifelse
  107.    /ByteOrder getsystemparam { 1 add } if
  108.    setobjectformat
  109.  } if
  110.  
  111. % ------ Virtual memory ------ %
  112.  
  113. /currentglobal            % - currentglobal <bool>
  114.   /currentshared load def
  115. /gcheck                % <obj> gcheck <bool>
  116.   /scheck load def
  117. /setglobal            % <bool> setglobal -
  118.   /setshared load def
  119. % We can make the global dictionaries very small, because they auto-expand.
  120. /globaldict currentdict /shareddict .knownget not { 4 dict } if def
  121. /GlobalFontDirectory SharedFontDirectory def
  122.  
  123. % ------ IODevices ------ %
  124.  
  125. /.getdevparams where {
  126.   pop /currentdevparams {    % <iodevice> currentdevparams <dict>
  127.     .getdevparams .dicttomark
  128.   } odef
  129. } if
  130. /.putdevparams where {
  131.   pop /setdevparams {        % <iodevice> <dict> setdevparams -
  132.     mark 1 index { } forall counttomark 2 add index
  133.     .putdevparams pop pop
  134.   } odef
  135. } if
  136.  
  137. % ------ Job control ------ %
  138.  
  139. serverdict begin
  140.  
  141. % We could protect the job information better, but we aren't attempting
  142. % (currently) to protect ourselves against maliciousness.
  143.  
  144. /.jobsave null def        % top-level save object
  145. /.jobsavelevel 0 def        % save depth of job (0 if .jobsave is null,
  146.                 % 1 otherwise)
  147. /.adminjob true def        % status of current unencapsulated job
  148.  
  149. /exitserver {            % <password> exitserver -
  150.   true exch startjob not { /exitserver /invalidaccess signalerror } if
  151. } bind def
  152.  
  153. end        % serverdict
  154.  
  155. % Because there may be objects on the e-stack created since the job save,
  156. % we have to clear the e-stack before doing the end-of-job restore.
  157. % We do this by executing a 2 .stop, which is caught by the 2 .stopped
  158. % in .runexec; we leave on the o-stack a procedure to execute aftewards.
  159. %
  160. %**************** The definition of startjob is not complete yet, since
  161. % it doesn't reset stdin/stdout or other aspects of the interpreter.
  162. /.finishstartjob {        % <exit_bool> <password_level>
  163.                 %   .finishstartjob -true-
  164.     serverdict /.jobsave get dup null eq { pop } { restore } ifelse
  165.     exch {
  166.             % Unencapsulated job
  167.       serverdict /.jobsave null put
  168.       serverdict /.jobsavelevel 0 put
  169.       serverdict /.adminjob 3 -1 roll 1 gt put
  170.     } {
  171.             % Encapsulated job
  172.       pop
  173.       serverdict /.jobsave save put
  174.       serverdict /.jobsavelevel 1 put
  175.       userdict /quit /stop load put
  176.     } ifelse true
  177. } bind def
  178. /startjob {            % <exit_bool> <password> startjob <ok_bool>
  179.   vmstatus pop pop serverdict /.jobsavelevel get eq
  180.   1 index .checkpassword 0 gt and {
  181.     .checkpassword count 2 roll count 2 sub { pop } repeat
  182.     cleardictstack
  183.         % Reset the e-stack back to the 2 .stopped in .runexec.
  184.     { .finishstartjob } 2 .stop
  185.   } {        % Password check failed
  186.     pop pop false
  187.   } ifelse
  188. } odef
  189.  
  190. systemdict begin
  191. /quit {                % - quit -
  192.   //systemdict begin serverdict /.jobsave get null eq
  193.    { end //quit }
  194.    { /quit load /invalidaccess /signalerror load end exec }
  195.   ifelse
  196. } bind odef
  197. end
  198.  
  199. % ------ Compatibility ------ %
  200.  
  201. % In Level 2 mode, the following replace the definitions that gs_statd.ps
  202. % installs in statusdict and serverdict.
  203. % Note that statusdict must be allocated in local VM.
  204. % We don't bother with many of these yet.
  205.  
  206. /.dict1 { exch mark 3 1 roll .dicttomark } bind def
  207.  
  208. currentglobal false setglobal 25 dict exch setglobal begin
  209. currentsystemparams
  210.  
  211. /buildtime 1 index /BuildTime get def
  212. /byteorder 1 index /ByteOrder get def
  213. /checkpassword { .checkpassword 0 gt } bind def
  214. /defaulttimeouts
  215.  { currentsystemparams dup
  216.    /JobTimeout .knownget not { 0 } if
  217.    exch /WaitTimeout .knownget not { 0 } if
  218.    currentpagedevice /ManualFeedTimeout .knownget not { 0 } if
  219.  } bind def
  220. dup /DoStartPage known
  221.  { /dostartpage { /DoStartPage getsystemparam } bind def
  222.    /setdostartpage { /DoStartPage .dict1 setsystemparams } bind def
  223.  } if
  224. dup /StartupMode known
  225.  { /dosysstart { /StartupMode getsystemparam 0 ne } bind def
  226.    /setdosysstart { { 1 } { 0 } ifelse /StartupMode .dict1 setsystemparams } bind def
  227.  } if
  228. %****** Setting jobname is supposed to set userparams.JobName, too.
  229. /jobname { /JobName getuserparam } bind def
  230. /jobtimeout { /JobTimeout getuserparam } bind def
  231. %manualfeed
  232. %manualfeedtimeout
  233. /margins
  234.  { currentpagedevice /Margins .knownget { exch } { [0 0] } ifelse
  235.  } bind def
  236. %pagecount
  237. %pagestackorder
  238. /printername
  239.  { currentsystemparams /PrinterName .knownget not { () } if exch copy
  240.  } bind def
  241. %/ramsize { /RamSize getsystemparam } bind def
  242. /realformat 1 index /RealFormat get def
  243.  
  244. /.setpagedevice where
  245.  { pop
  246.    /setdefaulttimeouts
  247.     { exch mark /ManualFeedTimeout 3 -1 roll
  248.       /Policies mark /ManualFeedTimeout 1 .dicttomark
  249.       .dicttomark setpagedevice
  250.       /WaitTimeout exch mark /JobTimeout 5 2 roll .dicttomark setsystemparams
  251.     } bind def
  252.    /setmargins
  253.     { exch 2 array astore /Margins .dict1 setpagedevice
  254.     } bind def
  255.  }
  256. if
  257. %setpagestackorder
  258. dup /PrinterName known
  259.  { /setprintername { /PrinterName .dict1 setsystemparams } bind def
  260.  } if
  261. currentuserparams /WaitTimeout known
  262.  { /waittimeout { /WaitTimeout getuserparam } bind def
  263.  } if
  264.  
  265. /.setpagedevice where
  266.  { pop 
  267.    /pagemargin
  268.     { currentpagedevice /PageOffset .knownget { 0 get } { 0 } ifelse
  269.     } bind def
  270.    /pageparams
  271.     { currentpagedevice
  272.       dup /Orientation .knownget { 1 and ORIENT1 { 1 xor } if } { 0 } ifelse exch
  273.       dup /PageSize get aload pop 3 index 0 ne { exch } if 3 2 roll
  274.       /PageOffset .knownget { 0 get } { 0 } ifelse 4 -1 roll
  275.     } bind def
  276.    /.setpagesize { 2 array astore /PageSize .dict1 setpagedevice } bind def
  277.    /setduplexmode { /Duplex .dict1 setpagedevice } bind def
  278.    /setpagemargin { 0 2 array astore /PageOffset .dict1 setpagedevice } bind def
  279.    /setpageparams
  280.     { mark /PageSize 6 -2 roll
  281.       4 index 1 and ORIENT1 { 1 } { 0 } ifelse ne { exch } if 2 array astore
  282.       /Orientation 5 -1 roll ORIENT1 { 1 xor } if
  283.       /PageOffset counttomark 2 add -1 roll 0 2 array astore
  284.       .dicttomark setpagedevice
  285.     } bind def
  286.    /setresolution
  287.     { dup 2 array astore /HWResolution .dict1 setpagedevice
  288.     } bind def
  289.  }
  290. if
  291.  
  292. pop        % currentsystemparams
  293.  
  294. % Flag the current dictionary so it will be swapped when we
  295. % change language levels.  (See zmisc2.c for more information.)
  296. /statusdict currentdict def
  297.  
  298. currentdict end
  299. /statusdict exch def
  300.  
  301. % ------ Color spaces ------ %
  302.  
  303. % Define the setcolorspace procedures:
  304. %    <colorspace> proc <colorspace'|null>
  305. /colorspacedict mark
  306.   /DeviceGray { pop 0 setgray null } bind
  307.   /DeviceRGB { pop 0 0 0 setrgbcolor null } bind
  308.   /setcmykcolor where
  309.    { pop /DeviceCMYK { pop 0 0 0 1 setcmykcolor null } bind
  310.    } if
  311.   /.setcieaspace where
  312.    { pop /CIEBasedA { NOCIE { pop 0 setgray null } { dup 1 get .setcieaspace } ifelse } bind
  313.    } if
  314.   /.setcieabcspace where
  315.    { pop /CIEBasedABC { NOCIE { pop 0 0 0 setrgbcolor null } { dup 1 get .setcieabcspace } ifelse } bind
  316.    } if
  317.   /.setciedefspace where
  318.    { pop /CIEBasedDEF { NOCIE { pop 0 0 0 setrgbcolor null } { dup 1 get .setciedefspace } ifelse } bind
  319.    } if
  320.   /.setciedefgspace where
  321.    { pop /CIEBasedDEFG { NOCIE { pop 0 0 0 1 setcmykcolor null } { dup 1 get .setciedefgspace } ifelse } bind
  322.    } if
  323.   /.setseparationspace where
  324.    { pop /Separation { dup 2 get setcolorspace dup .setseparationspace } bind
  325.    } if
  326.   /.setindexedspace where
  327.    { pop /Indexed { dup 1 get setcolorspace dup .setindexedspace } bind
  328.    } if
  329.   /.nullpatternspace [/Pattern] readonly def
  330.   /.setpatternspace where
  331.    { pop /Pattern
  332.       { dup type /nametype eq { pop //.nullpatternspace } if
  333.     dup length 1 gt { dup 1 get setcolorspace } if
  334.         dup .setpatternspace
  335.       } bind
  336.    } if
  337.   currentdict /.nullpatternspace .undef
  338. .dicttomark def
  339.  
  340. /.devcs [/DeviceGray /DeviceRGB /DeviceCMYK] readonly def
  341. /currentcolorspace {        % - currentcolorspace <array>
  342.   .currentcolorspace dup type /integertype eq {
  343.     //.devcs exch 1 getinterval
  344.   } if
  345. } odef
  346. currentdict /.devcs .undef
  347.  
  348. /setcolorspace {        % <name|array> setcolorspace -
  349.   dup dup dup type /nametype ne { 0 get } if
  350.   //colorspacedict exch get exec
  351.   dup null eq { pop } { .setcolorspace } ifelse pop
  352. } odef
  353.  
  354. % ------ CIE color rendering ------ %
  355.  
  356. /setcolorrendering where { pop } { (%END CRD) .skipeof } ifelse
  357.  
  358. % Initialize the CIE rendering dictionary if necessary.
  359. % The most common CIE files seem to assume the "calibrated RGB color space"
  360. % described on p. 189 of the PostScript Language Reference Manual,
  361. % 2nd Edition; we simply invert this transformation back to RGB.
  362. mark
  363.    /ColorRenderingType 1
  364. % We must make RangePQR and RangeLMN large enough so that values computed by
  365. % the assumed encoding MatrixLMN don't get clamped.
  366.    /RangePQR [0 0.9505 0 1 0 1.0890]
  367.    /TransformPQR [ { 4 { exch pop } repeat } dup dup ]
  368.    /RangeLMN [0 0.9505 0 1 0 1.0890]
  369.    /MatrixABC
  370.     [ 3.24063 -0.96893  0.05571
  371.      -1.53721  1.87576 -0.20402
  372.      -0.49863  0.04152  1.05700
  373.     ]
  374.    /EncodeABC [{0 max 0.45 exp} bind dup dup]
  375.    /WhitePoint [0.9505 1 1.0890]
  376.     % Some Genoa tests seem to require the presence of BlackPoint.
  377.    /BlackPoint [0 0 0]
  378. .dicttomark setcolorrendering
  379.  
  380. % Define findcolorrendering and a default ColorRendering ProcSet.
  381.  
  382. /findcolorrendering {        % <intentname> findcolorrendering
  383.                 %   <crdname> <found>
  384.   /ColorRendering /ProcSet findresource
  385.   1 index .namestring (.) concatstrings
  386.   1 index /GetPageDeviceName get exec .namestring (.) concatstrings
  387.   2 index /GetHalftoneName get exec .namestring
  388.   concatstrings concatstrings
  389.   dup /ColorRendering resourcestatus {
  390.     pop pop exch pop exch pop true
  391.   } {
  392.     pop /GetSubstituteCRD get exec false
  393.   } ifelse
  394. } odef
  395.  
  396. 5 dict dup begin
  397.  
  398. /GetPageDeviceName {        % - GetPageDeviceName <name>
  399.   currentpagedevice dup /PageDeviceName .knownget {
  400.     exch pop
  401.   } {
  402.     pop /none
  403.   } ifelse
  404. } bind def
  405.  
  406. /GetHalftoneName {        % - GetHalftoneName <name>
  407.   currenthalftone /HalftoneName .knownget not { /none } if
  408. } bind def
  409.  
  410. /GetSubstituteCRD {        % <intentname> GetSubstituteCRD <crdname>
  411.   pop /DefaultColorRendering
  412. } bind def
  413.  
  414. end
  415. % The resource machinery hasn't been activated, so just save the ProcSet
  416. % and let .fixresources finish the installation process.
  417. /ColorRendering exch def
  418.  
  419. %END CRD
  420.  
  421. % ------ Painting ------ %
  422.  
  423. % A straightforward definition of execform that doesn't actually
  424. % do any caching.
  425. /.execform1
  426.  {    % This is a separate operator so that the stacks will be restored
  427.     % properly if an error occurs.
  428.    dup /Implementation known not
  429.     { dup /FormType get 1 ne { /rangecheck signalerror } if
  430.       dup /Implementation null put readonly
  431.     } if
  432.    dup /Matrix get concat
  433.    dup /BBox get aload pop
  434.    exch 3 index sub exch 2 index sub rectclip
  435.    dup /PaintProc get exec
  436.  } odef
  437. /execform            % <form> execform -
  438.  { gsave { .execform1 } stopped grestore { stop } if
  439.  } odef
  440.  
  441. /makepattern {            % <proto_dict> <matrix> makepattern <pattern>
  442.   1 index dup length 1 add currentglobal
  443.    { false setglobal dict .copydict 1 index .buildpattern true setglobal }
  444.    { dict .copydict 1 index .buildpattern }
  445.   ifelse
  446.   1 index /Implementation 3 -1 roll put
  447.   readonly exch pop exch pop
  448. } odef
  449.  
  450. /setpattern {            % [<comp1> ...] <pattern> setpattern -
  451.   currentcolorspace 0 get /Pattern ne {
  452.     [ /Pattern currentcolorspace ] setcolorspace
  453.   } if setcolor
  454. } odef
  455.  
  456. end                % level2dict
  457.